(module environments (lib "eopl.ss" "eopl") 
  
  (require "data-structures.scm")
  (require "store.scm")
  (provide init-env empty-env extend-env apply-env env->list)

;;;;;;;;;;;;;;;; initial environment ;;;;;;;;;;;;;;;;
  
  ;; init-env : () -> environment

  ;; (init-env) builds an environment in which i is bound to the
  ;; expressed value 1, v is bound to the expressed value 5, and x is
  ;; bound to the expressed value 10.  

  (define init-env 
    (lambda ()
      (extend-env 
        'i (newref (num-val 1))
        (extend-env
          'v (newref (num-val 5))
          (extend-env
            'x (newref (num-val 10))
            (empty-env))))))

;;;;;;;;;;;;;;;; environment constructors and observers ;;;;;;;;;;;;;;;;

  (define apply-env
    (lambda (env search-sym)
      (cases environment env
        (empty-env ()
          (eopl:error 'apply-env "No binding for ~s" search-sym))
        (extend-env (bvar bval saved-env)
	  (if (eqv? search-sym bvar)
	    bval
	    (apply-env saved-env search-sym)))
        (extend-env-recursively
          (proc-names bvars bodies saved-env)
          (cond 
            ((location search-sym proc-names)
             => (lambda (n)
                  (newref
                    (proc-val
                      (procedure 
                        (list-ref bvars n)
                        (list-ref bodies n)
                        env)))))
            (else (apply-env saved-env search-sym)))))))

  (define env->list
    (lambda (env)
      (cases environment env
	(empty-env () '())
	(extend-env (sym val saved-env)
	  (cons
	    (list sym val)
	    (env->list saved-env)))
	(extend-env-recursively (proc-names bvars bodies saved-env)
	  (cons
	    (list 'letrec proc-names '...)
	    (env->list saved-env))))))

  (define shape-of
    (lambda (env)
      (cases environment env
        (empty-env () '())
        (extend-env (bvar bval saved-env)
          (cons bvar (shape-of saved-env)))
        (extend-env-recursively
          (proc-names bvars bodies saved-env)
          (cons proc-names (shape-of saved-env))))))

  (define location
    (lambda (sym syms)
      (cond
        ((null? syms) #f)
        ((eqv? sym (car syms)) 0)
        ((location sym (cdr syms))
         => (lambda (n) 
              (+ n 1)))
        (else #f))))

  )
